BBS in a Box 7/BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso/Files/Movie/Q-Z/VCR 2.0.cpt/VCR 2.0/stack.txt

Text File | 1990-04-09 | 7KB | 256 lines

-- stack: in.0
-- format: 8 (HyperCard 1)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 3
-- first background id: 2707
-- card count: 5
-- first card id: 19674
-- list block id: 2528
-- print block id: 3369
-- font table block id: 0
-- style table block id: 0
-- free block count: 0
-- free size: 0 bytes
-- total size: 26016 bytes
-- stack block size: 6144 bytes
-- created by hypercard version: 0x00000000
-- compacted by hypercard version: 0x01228000
-- modified by hypercard version: 0x01228000
-- opened by hypercard version: 0x01228000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x0000220000002200
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0xCC003300CC003300
-- patterns[4]: 0xCC883322CC883322
-- patterns[5]: 0xEE88BB22EE88BB22
-- patterns[6]: 0xEECCBB33EECCBB33
-- patterns[7]: 0xFFCCFF33FFCCFF33
-- patterns[8]: 0xFFEEFFBBFFEEFFBB
-- patterns[9]: 0xFFFFFFBBFFFFFFBB
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
on openStack
  push card
  if the number of this cd is 1 then hide cd fld data
  hide message box
  show menuBar
  play darn
  pass openStack
end openStack

function frac m
return m - trunc(m)
end frac

function sortl arg
-- ascending sort
put number of items of arg into n
repeat with j=1 to n-1
  put true into done
  repeat with i=j to n
    if item i of arg < item j of arg then
      put false into done
      set cursor to busy
      put item i of arg into z
      put item j of arg into item i of arg
      put z into item j of arg
    end if
  end repeat
  if done then exit repeat
end repeat
return arg
end sortl

function begNum
return number of first card of bg "Movies"
end begNum

on closeField
  if number of this cd > 5 then calc
end closeField

on search
  global itt
  if itt is not empty then go next card
  ask "Search for character string:" with itt
  if it is not empty then
    find chars it in fld Movies
    if the result is "not found" then
      play clang tempo 250 c4 d3
    end if
  end if
  put it into itt
end search

on calc
  put empty into z
  put (last line of field "Counter"+fld strip)/1000 into x
  if hilite of button "VHS" then
    put "VHS" into init
  else
    if hilite of button "Beta"
    then put "Beta" into init
  end if
  put trunc((line 1 of field 3 of card init) + x * ((line 2 of field 3 of card init) + x * line 3 of field 3 of card init))/60 into timeLeft
  put round(60 * frac(timeLeft)) into minutes
  if minutes <10 then put "0" into z
  put trunc(timeLeft) & ":" & z & minutes into field "Time Left"
end calc

on goTape
  global tape
  if tape is empty then
    ask "Go to videotape #" with "1"
    put it into tape
  end if
  if tape is empty then exit GoTape
  put false into found
  if (last char of tape) is "," then delete last char of tape
  go cd "x"&tape
  if the result is "No such card" then play boing
end goTape

on NuCard
  global num
  go last cd
  put field "num" into num
  DoMenu "Copy Card"
  DoMenu "Paste Card"
  repeat with i=1 to (the number of flds) -1
    if fld i is not empty then
      select text of fld i
      doMenu "Clear Text"
    end if
  end repeat
  Answer "Please select a tape format..." with "VHS" or "Beta-500" or "Beta"
  if it is "Beta" then
    set hilite of button "Beta" to true
    set hilite of button "VHS" to false
  else
    set hilite of button "VHS" to true
    set hilite of button "Beta" to false
  end if
  calc
end NuCard

on searchTime
  global start,num,i,she,buffer,dest,list
  repeat with i=start to num
    set cursor to busy
    put field "Time Left" of card i into time
    if the number of chars of time = 5 then exit repeat
    put 60*char 1 of time + (char 3 to 4 of time) into time2
    if time2 > she then
      if buffer≠0 then
        put time2-she+.1 into buffer
        put "," after list
        if buffer <100 then put "0" after list
        if buffer <10 then put "0" after list
        put trunc(buffer) &"." after list
        if i<10 then put "0" after list
        put i after list
      else
        put "," & i after list
      end if
      exit repeat
    end if
  end repeat
  if buffer=0 and i=num then
    play boing
    go recent card
    put 1 into i
  end if
end searchTime

on FindTime
  global start,num,i,buffer,she,dest,list
  put 0 into buffer
  put 0 into dest
  get 0
  push card
  put begNum() into list
  put begnum() into start
  put 240 into best
  put the number of cards into num
  repeat until it>0
    Ask "How many minutes do you seek (1 to exit)?"
  end repeat
  put it into she
  if she=1 then exit FindTime
  Answer "Fill tape to end?" with "No" or "Yes"
  if it is "Yes" then put -she into she
  if she<0 then
    put abs(she) into she
    set cursor to 4
    put begnum() into start
    put 239 into buffer
    searchTime
    repeat until i=num
      if buffer<best then
        put i into dest
        put buffer into best
        go cd dest
      end if
      put i+1 into start
      searchTime
    end repeat
    delete item 1 of list
    put number of items of list into nlist
    repeat with j=1 to nlist
      if number of chars of (item j of list) is 1 then put "0" before item j of list
    end repeat
    put sortl(list) into list
    repeat with j=2 to nlist
      Answer "Less buffer?" with "No" or "Yes"
      if it is "No" then exit repeat
      go card (char 5 to 6 of item j of list)
    end repeat
  else
    searchTime
    repeat until i=1
      go cd i
      Answer "Seek Another?" with "No" or "Yes"
      if it is "No" then exit repeat
      put i+1 into start
      searchTime
    end repeat
  end if
end FindTime